home *** CD-ROM | disk | FTP | other *** search
/ Delphi Developer's Kit 1996 / Delphi Developer's Kit 1996.iso / power / ussort / ussort.pas next >
Encoding:
Pascal/Delphi Source File  |  1995-12-22  |  3.5 KB  |  144 lines
  1. {I have developed a general purpose sort routine quite some time ago
  2. and put irt in one of my standard library units. The implementation is
  3. actually quite simple, becuase the application has to provide code for
  4. comparing and swapping the various elements. The only requirement is
  5. thta the elements must be available via an index (like an array or a
  6. random access file).
  7. I have included the code and a short description of the routine.
  8.  
  9. The sort is implemented as heapsort, because this sorting algorithm
  10. does not need significant memory space (as quicksort needs,
  11. particularly in case of a perfect ordered set!). The efficiency of
  12. this algorithm is quite good, actually outperfing quicksort in many
  13. reallife situations, where the data are already partly sorted..
  14. }
  15.  
  16.   Type
  17.     USSortLessType=Function(Index1: LongInt; Index2: LongInt):
  18. Boolean;
  19.     USSortSwapType=Procedure(Index1: LongInt; Index2: LongInt);
  20.  
  21.  
  22.   Function USSort(
  23.    IndexLow: LongInt;
  24.    IndexHigh: LongInt;
  25.    USSortLess: USSortLessType;
  26.    USSortSwap: USSortSwapType): Byte;
  27.  
  28.   Label
  29.     99;
  30.  
  31.   Var
  32.     L: LongInt;
  33.     I: LongInt;
  34.     J: LongInt;
  35.     Length: LongInt;
  36.     IR: LongInt;
  37.     IRRA: LongInt;
  38.  
  39.   Begin
  40.   Length:=IndexHigh-IndexLow+1;
  41.   If Length>1 Then
  42.     Begin
  43.     L:=(Length Div 2)+1;
  44.     IR:=Length;
  45.  
  46.     While TRUE Do
  47.       Begin
  48.       If L>1 Then
  49.         Begin
  50.         Dec(L);
  51.         IRRA:=L;
  52.         End
  53.       Else
  54.         Begin
  55.         USSortSwap(IR+IndexLow-1,1+IndexLow-1);
  56.         IRRA:=1;
  57.         Dec(IR);
  58.         If IR=1 Then
  59.           Begin
  60.           Goto 99;
  61.           End;
  62.         End;
  63.       I:=L;
  64.       J:=L+L;
  65.       While J<=IR Do
  66.         Begin
  67.         If J<IR Then
  68.           Begin
  69.           If USSortLess(J+IndexLow-1,J+1+IndexLow-1) Then
  70.             Begin
  71.             Inc(J);
  72.             End;
  73.           End;
  74.         If USSortLess(IRRA+IndexLow-1,J+IndexLow-1) Then
  75.           Begin
  76.           USSortSwap(I+IndexLow-1,J+IndexLow-1);
  77.           IRRA:=J;
  78.           I:=J;
  79.           J:=J+J;
  80.           End
  81.         Else
  82.           Begin
  83.           J:=IR+1;
  84.           End;
  85.         End;
  86.       End;
  87.     99:
  88.       End;
  89.  
  90.     USSort:=0;
  91.     End; {USSort}
  92.  
  93. {
  94. *START DESCRIPTION*
  95. The functione USSort may be used to sort a set of elements. The
  96. routine 
  97. is transparent to the type of information in the set.
  98. The elements in the set are are indexed and the lower and upper
  99. indexed 
  100. are given by the parameters IndexLow and IndexHigh.
  101. The calling program should provide a function USSortLess, which 
  102. must return TRUE if the element indexed by the first parameter is 
  103. less than the element indexed by the second parameter.
  104. Furthermore, a procedure USSortSwap must be provided. This 
  105. routine must swap the elements indexed by the two parameters.
  106.  
  107. The function returns with 0 if the sort completed successfully.
  108. Otherwise, 
  109. the error code 1 is returned, indicating insufficient memory to sort 
  110. the set.
  111.  
  112.  
  113. Example
  114.  
  115. Var
  116.   Table: Array[1..100] Of Real;
  117.  
  118. Function SortLess(Index1: LongInt; Index2: LongInt): Boolean; Far;
  119.   Begin
  120.   SortLess:=Table[Index1]<<Table[Index2];
  121.   End;
  122.  
  123. Procedure SortSwap(Index1: LongInt; Index2: LongInt); Far;
  124.   Var
  125.     Temp: Real;
  126.   Begin
  127.   Temp:=Table[Index1];
  128.   Table[Index1]:=Table[Index2];
  129.   Table[Index2]:=Temp;
  130.   End;
  131.  
  132. Begin
  133. {Fill Table}
  134. Result:=USSort(1,100,SortLess,SortSwap);
  135.  
  136. In this example, the table with 100 reals will be sorted.
  137.  
  138. Please let me know if you need further assistance (via the Newsgroup
  139. of email rvdham@ect.nl)
  140.  
  141. }
  142.  
  143.  
  144.